(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ") T) (LISPXPRIN1 (QUOTE 
"18-NOV-72  3:33:00") T) (LISPXTERPRI T))
(LISPXPRINT (QUOTE CLVARS) T)
(RPAQQ CLVARS ((FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS
CLCREATE CLINSERT CL=PARTS CLBYVALENCE CLPARTITIONSL) (VARS)))
(DEFINEQ

(CLDIFF
(LAMBDA (CL1 CL2) (FOR NEW PR IN CL1 AS NEW N IS (IDIFFERENCE (CDR
PR) (LMASSOC (CAR PR) CL2 0)) WHEN (IGREATERP N 0) LIST (CONS (CAR
PR) N))))

(CLCOUNT
(LAMBDA (CL) (FOR NEW PR IN CL IPLUS (CDR PR))))

(CLPARTS
(LAMBDA (CL PARTSIZE) (IF (ZEROP PARTSIZE) THEN (LIST NIL) ELSEIF
(NULL (CDR CL)) THEN (LIST (LIST (CONS (CAAR CL) PARTSIZE))) ELSE
(PROG (SIZE) (SETQ SIZE (IDIFFERENCE PARTSIZE (CLCOUNT (CDR CL))))
(RETURN (FOR NEW X := ((MAX SIZE 1) (MIN PARTSIZE (CDAR CL))) FOR
NEW PART IN (CLPARTS (CDR CL) (DIFFERENCE PARTSIZE X)) XLIST FIRST
(IF (LESSP 0 SIZE) THEN NIL ELSE (CLPARTS (CDR CL) PARTSIZE)) (CONS
(CONS (CAAR CL) X) PART)))))))

(CLPARTITIONSN
(LAMBDA (CL N MINPARTSIZE MAXPARTSIZE) (FOR NEW PARTSIZES IN (
NUMPARTITIONS (CLCOUNT CL) N MINPARTSIZE MAXPARTSIZE) NCONC (
CLPARTITIONS CL PARTSIZES))))

(CLPARTITIONS
(LAMBDA (CL PARTSIZES) (IF (NOT (CDR PARTSIZES)) THEN (LIST (LIST
CL)) ELSEIF (ZEROP (CAR PARTSIZES)) THEN (MAPCAR (CLPARTITIONS CL
(CDR PARTSIZES)) (FUNCTION (LAMBDA (X) (CONS NIL X)))) ELSEIF (EQUAL
(CAR PARTSIZES) (CADR PARTSIZES)) THEN (PROG (N THISPART) (SETQ N
1) (SETQ THISPART (CAR PARTSIZES) PARTSIZES) (FOR PARTSIZES ON (CDR
PARTSIZES) WHILE (EQP (CAR PARTSIZES) THISPART) DO (SETQ N (ADD1 N)))
(IF (NOT PARTSIZES) THEN (RETURN (CL=PARTS CL N THISPART))) (RETURN
(FOR NEW BIGPART IN (CLPARTS CL (TIMES N THISPART)) AS NEW RESTPARTSLIST
IS (CLPARTITIONSFF CL BIGPART) FOR NEW LITTLEPARTS IN (CL=PARTS BIGPART
N THISPART) FOR NEW RESTPARTS IN RESTPARTSLIST XLIST (APPEND LITTLEPARTS
RESTPARTS)))) ELSE (FOR NEW PART IN (CLPARTS CL (CAR PARTSIZES)) FOR
NEW PARTS IN (CLPARTITIONS (CLDIFF CL PART) (CDR PARTSIZES)) XLIST
(CONS PART PARTS)))))

(CLCREATE
(LAMBDA (L) (PROG (CL) (FOR NEW X IN L DO (SETQ CL (CLINSERT X CL)))
(RETURN CL))))

(CLINSERT
(LAMBDA (ITEM CL) (IF (NOT CL) THEN (LIST (CONS ITEM 1)) ELSEIF (EQUAL
ITEM (CAAR CL)) THEN (REPLACE (CDAR CL) (ADD1 (CDAR CL))) CL ELSEIF
(LEQ ITEM (CAAR CL)) THEN (CONS (CONS ITEM 1) CL) ELSE (REPLACE (CDR
CL) (CLINSERT ITEM (CDR CL))))))

(CL=PARTS
(LAMBDA (CL NPARTS PARTSIZE) (IF (NOT (CDR CL)) THEN (SETQ CL (LIST
(CONS (CAAR CL) PARTSIZE))) (LIST (FOR NEW I := (1 NPARTS) XLIST CL))
ELSE (FOR NEW X IN (NUMPARTITIONS (CDAR CL) NPARTS 0 PARTSIZE) FOR
NEW Y IN (CLPARTITIONS (CDR CL) (FOR NEW XX IN X LIST (DIFFERENCE
PARTSIZE XX))) XLIST (FOR NEW XX IN X AS NEW YY IN Y LIST (IF (ZEROP
XX) THEN YY ELSE (CONS (CONS (CAAR CL) XX) YY)))))))

(CLBYVALENCE
(LAMBDA (CL) (SETQ CL (GROUPBY (FUNCTION (LAMBDA (PR) (VALENCE (CAR
PR)))) CL)) (FOR NEW I := (2 (*MAX (MAPCAR CL (FUNCTION CAR)))) LIST
(LMASSOC I CL NIL))))

(CLPARTITIONSL
(LAMBDA (CL LL) (IF (NOT LL) THEN (LIST NIL) ELSE (FOR NEW FP IN (
CLPARTS CL (*PLUS (CAR LL))) AS NEW RPL IS (CLPARTITIONSL (CLDIFF
CL FP) (CDR LL)) FOR NEW TP IN (CLPARTLP1 FP (CAR LL) 1) FOR NEW RP
IN RPL XLIST (CONS TP RP)))))
)
STOP